;;; -*- mode: lisp; coding: utf-8; -*-

#|
  This file is a part of cl-tmcl project.
|#

(in-package :cl-tmcl)





;;;


(defvar +start-marker+ "<%")
(defvar +end-marker+ "%>")


(defun rendout-raw-string (s &key (output-stream *standard-output*))
  (declare (inline))
  (write `(format t ,s) :stream output-stream))

(defun rendout-lisp-string (s &key (output-stream *standard-output*))
  (declare (inline))
  (format output-stream s))

(defun rendout-lisp-out-string (s &key (output-stream *standard-output*))
  (declare (inline))
  (format output-stream "(format t \"~~a\" ~a)" s))

(defun rendout-prologue (&key (output-stream *standard-output*))
  (declare (inline))
  (format output-stream "(lambda () "))

(defun rendout-epilogue (&key (output-stream *standard-output*))
  (declare (inline))
  (format output-stream ") "))


(defun process-tag (s last-pos start &key (output-stream *standard-output*))
  (declare (inline))
  (let* ((tag-content-start (+ (length +start-marker+) start))
          (tag-content-end (search +end-marker+ s :start2 tag-content-start))
          (tag-content (subseq s tag-content-start tag-content-end)))
    ;; before tag
    (rendout-raw-string (subseq s last-pos start) :output-stream output-stream)
    ;; tag content            
    (if (starts-with-subseq "=" tag-content)
      (rendout-lisp-out-string (subseq tag-content 1) :output-stream output-stream)
      (rendout-lisp-string tag-content :output-stream output-stream))
    ;; ...next
    (if tag-content-end
      ;; then, update 'last-pos' & continue
      (+ tag-content-end (length +end-marker+))
      ;; else, or exit-loop (end-string)
      nil)))


(defun %transform-string (s) 
  (capture-output
    (rendout-prologue)
    ;;
    (let ((last-pos 0)
           (start nil))
      (loop do
        (setf start (search +start-marker+ s :start2 last-pos))
        (if (null start)
          ;; then, flush rests, quit searching.
          (progn
            (rendout-raw-string (subseq s last-pos))
            (return))
          ;; else, escape-tag search?
          (let ((new-last-pos (process-tag  s last-pos start)))
            (if (null new-last-pos)
              (return)
              (setf last-pos new-last-pos))))))
    ;;
    (rendout-epilogue)))





(defun transform-string (s)
  (call-before-after-filters 
    *before-transform-string-filters* *after-transform-string-filters*
    s (%transform-string s)))



;;;


(defparameter *cur-template-pathname* nil)


(defun %read-from-string (s) 
  (call-before-after-filters
    *before-read-from-string-filters* *after-read-from-string-filters*
    s
    (read-from-string s)))

(defun %eval (o)
  (call-before-after-filters
    *before-eval-lambda-form-filters* *after-eval-lambda-form-filters*
    o
    (eval o)))

(defun %funcall (f)
  (call-before-after-filters
    *before-funcall-template-filters* *after-funcall-template-filters*
    f
    (funcall f)))

(defun render-string (s &key (template-pathname nil))
  (let-specials ((*cur-template-pathname* template-pathname))
    (call-before-after-filters
      *before-render-string-filters* *after-render-string-filters*
      s
      (capture-output (%funcall (%eval (%read-from-string (transform-string s))))))))



(defun render-file (file-pn &key (base-dir nil))
  " :base-dir
    - nil : default, no base-dir prepended.
    - t : base-dir is extracted from *cur-template-pathname*.
    - other pathname object : just used as a prepended base-dir.
  "
  (let ((template-pathname file-pn))
    (cond
      ((null base-dir) (setf template-pathname file-pn))
      ((eq t base-dir) (setf template-pathname 
                         (merge-pathnames file-pn *cur-template-pathname*)))
      ((pathnamep base-dir) (setf template-pathname
                              (merge-pathnames file-pn base-dir))))
    ;;
    (let ((template-string 
            (call-before-after-filters 
              *before-read-template-file-filters* *after-read-template-file-filters*
              template-pathname
              (read-file-into-string template-pathname))))
      (render-string template-string
        :template-pathname template-pathname))))






;;; EOF
